home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d23
/
zipstamp.arc
/
ZIPSTAMP.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1989-06-22
|
3KB
|
129 lines
{$A-,B-,D+,E-,F-,I-,L+,N-,O-,R-,S-,V-}
{$M 16384,0,655360}
program ZipList;
uses
TpCrt, { Turbo Power's CRT Unit - can use CRT with NO modification }
Zipper, { Zip code from Thomas Guinther }
Engine, { Directory engine code from Turbo Technix }
DOS; { Standard Borland DOS unit }
const
CompMethodStr :array[0..5]of String=('No Compression','Shrunk','Reduced (CF=1)',
'Reduced (CF=2)','Reduced (CF=3)','Reduced (CF=5)');
var
LastDate :Word;
LastTime :Word;
Ch : Char;
type
TimeDateRec =record
Date :Word;
Time :Word;
end;
var
zF :zFile;
Zrec :ZipDirRec;
TimeDate :TimeDateRec;
TimeDateStamp :LongInt absolute TimeDate;
UnPakedRec :DateTime;
Error :Byte;
Function ZeroPad(S:String):String;
begin
If Length(s) = 1 then S:='0'+S;
ZeroPad := S;
end;
procedure GetDates(pZ:pZipDir);
begin
with pZ^,pCD^,FileInfo do
begin
if FDate>LastDate then
begin
LastDate:=FDate;
LastTime:=FTime;
end;
end;
end;
{$F+}
procedure StampIt(Var S:SearchRec;path:PathStr);
var
Ch : Char;
Hours : String[2];
MinS : String[2];
Secs : String[2];
begin
LastDate:=0;
LastTime:=0;
if not OpenZip(zF,Path+S.Name)then
begin
Gotoxy(1,20);
Write('Unable to open: ',Path+S.Name);
ClrEol;
Exit;
end;
If Path = '' then
begin
GetDir(0,Path);
Path := Path +'\';
end;
Gotoxy(1,12);
Write('Processing file ',Path+S.Name);ClrEol;
Writeln;
if FindCentralDirectory(zF)<>0 then
begin
while ReadCentralDirEntry(zF, @Zrec)do
begin
GetDates(@Zrec);
FreeZipRec(@Zrec);
end;
TimeDate.Time:=LastDate;
TimeDate.Date:=LastTime;
UnpackTime(TimeDateStamp,UnPakedRec);
Str(UnpakedRec.Hour,Hours);
Str(UnpakedRec.Min,Mins);
Str(UnpakedRec.Sec,Secs);
with UnPakedRec do
Write('Latest file stamp is : ',Month,'/',Day,'/',
Year,' ', ZeroPad(HourS),':',ZeroPad(MinS),':',ZeroPad(SecS));
ClrEol;
end
else
WriteLn(Path+S.Name+': Unable to find ZIP directory.');
SetFTime(zF,TimeDateStamp);
Close(zF);
end;
procedure FindAndProcessAllZips;
begin
If (ParamStr(1) = '/s') or (ParamStr(1) = '/S') then
SearchEngineAll('\','*.ZIP',AnyFile,StampIt,Error)
else
SearchEngine('*.ZIP',AnyFile,StampIt,Error);
end;
{$F-}
begin
ClrScr;
DirectVideo:=True;
Writeln('ZipStamp - Based upon Zip Directory code by Mr. Thomas Guinther');
Writeln('By Stephen Genusa - 149 Wheeler Road - Monroe, LA 71203');
Writeln;
Writeln;
Writeln('Use the /s parameter to search the entire hard disk.');
Writeln;
Writeln('Press any key to start - this will not take very long!');
Ch := Readkey;
FindAndProcessAllZips;
end.